home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Toolbox classes / Window+ < prev    next >
Text File  |  1993-02-08  |  3KB  |  140 lines
  1. \ Window+ class - a window that supports views.
  2. \ Oct 91    mrh    Initial version.
  3. \ May 92    mrh    "New-style" controls
  4. \ Feb 93    mrh    Added sending idle: to the contView
  5.  
  6. need    view
  7. need    scroller
  8.  
  9. :class    WINDOW+  super{ window }
  10.  
  11.     ptr        ^CONTVIEW        \ Points to view consisting of contents rect.
  12.     bool    ZOOMFLG
  13.     
  14. :m SETZOOM:    \ ( b -- )  Passed-in boolean indicates if this window
  15.             \        will be  zoomable.
  16.     put: zoomFlg  ;m
  17.  
  18. :m SETVIEW:  { ^view -- }
  19.     ^view  put: ^contView  ^base setWindow: ^view  ;m
  20.  
  21. :m GETVIEW:    get: ^contView  ;m
  22.  
  23. :m NEW:  { bndsRect tAddr tLen procID vis goAway ^view \ s255 -- }
  24.  
  25.     get: alive  ?EXIT                \ Out if already alive
  26.     ^view  setView: self
  27.     ?disable_actW: self
  28.     tAddr tLen  str255  -> s255
  29.     0  ^base  bndsrect  s255  vis Tbool
  30.     get: zoomFlg  8 and  procID + makeint
  31.     inFront  goAway Tbool  0
  32.     call NewWindow  drop
  33.     initNewWindow: self
  34.     getRect: self  init: [ get: ^contView ]
  35.     nilP  new: [ get: ^contView ]    \ Fire up view object
  36. ;m
  37.  
  38. :m GETNEW:  { resID ^view -- }
  39.     get: alive  ?EXIT                \ Out if already alive
  40.     ^view  setView: self
  41.     resID  getnew: super
  42.     getRect: self  init: [ get: ^contView ]
  43.     nilP  new: [ get: ^contView ]    \ Fire up view object
  44. ;m
  45.  
  46. :m GROW:
  47.     grow: super
  48.     getRect: self  get: ^contView  setRect: **  ;m
  49.  
  50. :m ZOOM:
  51.     zoom: super  set: super
  52.     getRect: self  get: ^contView  setRect: **  ;m
  53.  
  54. :m ENABLE:
  55.     enable: super        \ Note - we do this first to make sure the
  56.                         \ current grafPort is set before the views
  57.                         \ do anything.
  58.     get: ^contView  enable: **    enable: super   ;m
  59.     
  60. :m DISABLE:    get: ^contView  disable: **   disable: super  ;m
  61.  
  62. :m (DRAW):        \ Draws the window with controls
  63.     (draw): super
  64.     draw: [ get: ^contview ]
  65.     ^base  call DrawControls  ;m
  66.  
  67. :m DRAW:    (draw): self  ;m
  68.  
  69. :m IDLE:    idle: super
  70.             get: ^contView  idle: **  ;m
  71.  
  72. :m CLOSE:        \ Disposes of window's controls and closes the window
  73.     get: ^contView  release: **
  74.     ^base  call KillControls  close: super  ;m
  75.  
  76.  
  77. :m CONTENT:        \ Handles a content click
  78.     active: self
  79.     IF    ^base  ctlHit?
  80.         NIF  get: ^contView  click: **  drop  THEN
  81.     ELSE    select: self
  82.     THEN  ;m
  83.  
  84.  
  85. :m KEY:        \ ( c -- )  For typed keys, we'll send a KEY: to the
  86.             \ contView and thus to all the views.  They can do
  87.             \ whatever they like with it.
  88.     get: ^contView  key: **  ;m
  89.     
  90.  
  91. :m TEST:  { ^view -- }
  92.     100 100 400 300 put: tempRect
  93.     screenbits true setGrow: self
  94.     true  setZoom: self
  95.     tempRect  " Test"  docWind  true true  ^view  new: self  ;m
  96.  
  97. ;class
  98.  
  99.  
  100. \ endload
  101.  
  102.  
  103. \ TESTING:
  104.  
  105. window+        WW
  106. scroller    S1    20 >toffs: s1
  107. scroller    S2    floating floating  2dup  setModes: s2
  108.             20 20  400 200   init: s2
  109.  
  110. view        VV    anchored floating  2dup  setModes: vv
  111.             32 32  628 328  init: vv
  112.  
  113.    screenbits    true  setGrow: ww
  114.                 true  setZoom: ww
  115.  
  116. : DRW  { \ l t r b -- }        \ Draws a big X across the view area.
  117.     clear: temprect  get: tempRect  -> b  -> r  -> t  -> l
  118.     0 0 gotoxy  r b pack call LineTo
  119.     l b gotoxy  r 0 pack call LineTo  ;
  120.  
  121. ' drw  setDraw: vv
  122.  
  123.  
  124. : CLICK1        ." clicked s1!" cr  ;
  125. : CLICK2        ." clicked s2!" cr  ;
  126.  
  127. ' click1   setClick: s1     ' click2   setClick: s2
  128.  
  129. : GO
  130.     vv addView: s2  s2  addView: s1
  131.     s1 test: ww  ;
  132.     
  133.  
  134. \ : RR        \ Test getting things from a resource file
  135. \    " WindTest.rsrc" openresfile
  136. \    128 db getNew: ww
  137. \    128 ww getNew: vv1  ;
  138.  
  139.  : ZZ    set: fwind   close: ww  ;
  140.